install.pas 50 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869
  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) shr 10;
  1042. if Space < DSize then
  1043. S := 'is not'
  1044. else
  1045. S := '';
  1046. if (Space < DSize + 500) then
  1047. begin
  1048. if S = '' then
  1049. S := 'might not be';
  1050. if messagebox('There ' + S + ' enough space on the target ' +
  1051. 'drive for all the selected components. Do you ' +
  1052. 'want to change the installation path?',nil,
  1053. mferror+mfyesbutton+mfnobutton) = cmYes then
  1054. Continue;
  1055. end;
  1056. {$ENDIF}
  1057. if createinstalldir(data.basepath) then
  1058. break;
  1059. end
  1060. else
  1061. begin
  1062. { maybe only config }
  1063. if (data.cfgval and 1)<>0 then
  1064. begin
  1065. result:=messagebox('No components selected.'#13#13'Create a configfile ?',nil,
  1066. mfinformation+mfyesbutton+mfnobutton);
  1067. if (result=cmYes) and createinstalldir(data.basepath) then
  1068. doconfigwrite;
  1069. exit;
  1070. end
  1071. else
  1072. begin
  1073. result:=messagebox('No components selected.'#13#13'Abort installation?',nil,
  1074. mferror+mfyesbutton+mfnobutton);
  1075. if result=cmYes then
  1076. exit;
  1077. end;
  1078. end;
  1079. end;
  1080. end
  1081. else
  1082. exit;
  1083. until false;
  1084. { extract packages }
  1085. for j:=1 to cfg.packs do
  1086. with cfg.pack[j] do
  1087. begin
  1088. r.assign(10,7,70,18);
  1089. UnzDlg:=new(punzipdialog,init(r,'Extracting Packages'));
  1090. desktop^.insert(UnzDlg);
  1091. for i:=1 to packages do
  1092. begin
  1093. if data.packmask[j] and packagemask(i)<>0 then
  1094. begin
  1095. UnzDlg^.do_unzip(package[i].zip,data.basepath);
  1096. { gather some information about the installed files }
  1097. if copy(package[i].zip,1,3)='ide' then
  1098. haside:=true;
  1099. if copy(package[i].zip,1,7)='doc-htm' then
  1100. hashtmlhelp:=true;
  1101. end;
  1102. end;
  1103. desktop^.delete(UnzDlg);
  1104. dispose(UnzDlg,done);
  1105. end;
  1106. { write config }
  1107. if (data.cfgval and 1)<>0 then
  1108. doconfigwrite;
  1109. { show end message }
  1110. p3:=new(penddialog,init);
  1111. executedialog(p3,nil);
  1112. end;
  1113. procedure tapp.readcfg(const fn:string);
  1114. var
  1115. t : text;
  1116. i,j,k,
  1117. line : longint;
  1118. item,
  1119. s,hs : string;
  1120. params : array[0..0] of pointer;
  1121. {$ifndef FPC}
  1122. procedure readln(var t:text;var s:string);
  1123. var
  1124. c : char;
  1125. i : longint;
  1126. begin
  1127. c:=#0;
  1128. i:=0;
  1129. while (not eof(t)) and (c<>#10) do
  1130. begin
  1131. read(t,c);
  1132. if c<>#10 then
  1133. begin
  1134. inc(i);
  1135. s[i]:=c;
  1136. end;
  1137. end;
  1138. if (i>0) and (s[i]=#13) then
  1139. dec(i);
  1140. s[0]:=chr(i);
  1141. end;
  1142. {$endif}
  1143. begin
  1144. assign(t,StartPath + DirSep + fn);
  1145. {$I-}
  1146. reset(t);
  1147. {$I+}
  1148. if ioresult<>0 then
  1149. begin
  1150. StartPath := GetProgDir;
  1151. assign(t,StartPath + DirSep + fn);
  1152. {$I-}
  1153. reset(t);
  1154. {$I+}
  1155. if ioresult<>0 then
  1156. begin
  1157. params[0]:=@fn;
  1158. messagebox('File %s not found!',@params,mferror+mfokbutton);
  1159. errorhalt;
  1160. end;
  1161. end;
  1162. line:=0;
  1163. while not eof(t) do
  1164. begin
  1165. readln(t,s);
  1166. inc(line);
  1167. if (s<>'') and not(s[1] in ['#',';']) then
  1168. begin
  1169. i:=pos('=',s);
  1170. if i>0 then
  1171. begin
  1172. item:=upper(Copy(s,1,i-1));
  1173. system.delete(s,1,i);
  1174. if item='VERSION' then
  1175. cfg.version:=s
  1176. else
  1177. if item='TITLE' then
  1178. cfg.title:=s
  1179. else
  1180. if item='BASEPATH' then
  1181. cfg.basepath:=s
  1182. else
  1183. if item='HELPIDX' then
  1184. cfg.helpidx:=s
  1185. else
  1186. if item='DOCSUB' then
  1187. cfg.docsub:=s
  1188. else
  1189. if item='DEFAULTCFG' then
  1190. begin
  1191. repeat
  1192. readln(t,s);
  1193. if upper(s)='ENDCFG' then
  1194. break;
  1195. if cfg.defcfgs<maxdefcfgs then
  1196. begin
  1197. inc(cfg.defcfgs);
  1198. cfg.defcfg[cfg.defcfgs]:=newstr(s);
  1199. end;
  1200. until false;
  1201. end
  1202. else if item='DEFAULTIDECFG' then
  1203. begin
  1204. repeat
  1205. readln(t,s);
  1206. if upper(s)='ENDCFG' then
  1207. break;
  1208. if cfg.defidecfgs<maxdefcfgs then
  1209. begin
  1210. inc(cfg.defidecfgs);
  1211. cfg.defidecfg[cfg.defidecfgs]:=newstr(s);
  1212. end;
  1213. until false;
  1214. end
  1215. else if item='DEFAULTIDEINI' then
  1216. begin
  1217. repeat
  1218. readln(t,s);
  1219. if upper(s)='ENDCFG' then
  1220. break;
  1221. if cfg.defideinis<maxdefcfgs then
  1222. begin
  1223. inc(cfg.defideinis);
  1224. cfg.defideini[cfg.defideinis]:=newstr(s);
  1225. end;
  1226. until false;
  1227. end
  1228. else
  1229. if item='PACK' then
  1230. begin
  1231. inc(cfg.packs);
  1232. if cfg.packs>maxpacks then
  1233. begin
  1234. writeln('Too many packs');
  1235. halt(1);
  1236. end;
  1237. cfg.pack[cfg.packs].name:=s;
  1238. end
  1239. else
  1240. if item='CFGFILE' then
  1241. begin
  1242. if cfg.packs=0 then
  1243. begin
  1244. writeln('No pack set');
  1245. halt(1);
  1246. end;
  1247. cfg.pack[cfg.packs].defcfgfile:=s
  1248. end
  1249. else
  1250. if item='IDECFGFILE' then
  1251. begin
  1252. if cfg.packs=0 then
  1253. begin
  1254. writeln('No pack set');
  1255. halt(1);
  1256. end;
  1257. cfg.pack[cfg.packs].defidecfgfile:=s
  1258. end
  1259. else
  1260. if item='IDEINIFILE' then
  1261. begin
  1262. if cfg.packs=0 then
  1263. begin
  1264. writeln('No pack set');
  1265. halt(1);
  1266. end;
  1267. cfg.pack[cfg.packs].defideinifile:=s
  1268. end
  1269. else
  1270. if item='PPC386' then
  1271. begin
  1272. if cfg.packs=0 then
  1273. begin
  1274. writeln('No pack set');
  1275. halt(1);
  1276. end;
  1277. cfg.pack[cfg.packs].ppc386:=s;
  1278. end
  1279. else
  1280. if item='BINSUB' then
  1281. begin
  1282. if cfg.packs=0 then
  1283. begin
  1284. writeln('No pack set');
  1285. halt(1);
  1286. end;
  1287. cfg.pack[cfg.packs].binsub:=s;
  1288. end
  1289. else
  1290. if item='FILECHECK' then
  1291. begin
  1292. if cfg.packs=0 then
  1293. begin
  1294. writeln('No pack set');
  1295. halt(1);
  1296. end;
  1297. cfg.pack[cfg.packs].filechk:=s;
  1298. end
  1299. else
  1300. if item='TARGETNAME' then
  1301. begin
  1302. if cfg.packs=0 then
  1303. begin
  1304. writeln('No pack set');
  1305. halt(1);
  1306. end;
  1307. cfg.pack[cfg.packs].targetname:=s;
  1308. end
  1309. else
  1310. if item='PACKAGE' then
  1311. begin
  1312. if cfg.packs=0 then
  1313. begin
  1314. writeln('No pack set');
  1315. halt(1);
  1316. end;
  1317. with cfg.pack[cfg.packs] do
  1318. begin
  1319. j:=pos(',',s);
  1320. if (j>0) and (packages<maxpackages) then
  1321. begin
  1322. inc(packages);
  1323. hs:=copy(s,1,j-1);
  1324. k:=pos('[',hs);
  1325. if (k>0) then
  1326. begin
  1327. package[packages].zip:=Copy(hs,1,k-1);
  1328. package[packages].zipshort:=Copy(hs,k+1,length(hs)-k-1);
  1329. end
  1330. else
  1331. package[packages].zip:=hs;
  1332. package[packages].name:=copy(s,j+1,255);
  1333. end;
  1334. package[packages].diskspace:=-1;
  1335. end;
  1336. end
  1337. end;
  1338. end;
  1339. end;
  1340. close(t);
  1341. end;
  1342. procedure tapp.checkavailpack;
  1343. var
  1344. j : longint;
  1345. dir : searchrec;
  1346. begin
  1347. { check the packages }
  1348. j:=0;
  1349. while (j<cfg.packs) do
  1350. begin
  1351. inc(j);
  1352. if cfg.pack[j].filechk<>'' then
  1353. begin
  1354. findfirst(cfg.pack[j].filechk,$20,dir);
  1355. if doserror<>0 then
  1356. begin
  1357. { remove the package }
  1358. move(cfg.pack[j+1],cfg.pack[j],sizeof(tpack)*(cfg.packs-j));
  1359. dec(cfg.packs);
  1360. dec(j);
  1361. end;
  1362. {$IFNDEF TP}
  1363. findclose(dir);
  1364. {$ENDIF}
  1365. end;
  1366. end;
  1367. end;
  1368. procedure tapp.initmenubar;
  1369. var
  1370. r : trect;
  1371. begin
  1372. getextent(r);
  1373. r.b.y:=r.a.y+1;
  1374. menubar:=new(pmenubar,init(r,newmenu(
  1375. newsubmenu('Free Pascal Installer',hcnocontext,newmenu(nil
  1376. ),
  1377. nil))));
  1378. end;
  1379. procedure tapp.handleevent(var event : tevent);
  1380. begin
  1381. inherited handleevent(event);
  1382. if event.what=evcommand then
  1383. if event.command=cmstart then
  1384. begin
  1385. clearevent(event);
  1386. do_installdialog;
  1387. if successfull then
  1388. begin
  1389. event.what:=evcommand;
  1390. event.command:=cmquit;
  1391. handleevent(event);
  1392. end;
  1393. end;
  1394. end;
  1395. {$IFDEF DOSSTUB}
  1396. function CheckOS2: boolean;
  1397. var
  1398. OwnName: PathStr;
  1399. OwnDir: DirStr;
  1400. Name: NameStr;
  1401. Ext: ExtStr;
  1402. DosV, W: word;
  1403. P: PChar;
  1404. const
  1405. Title: string [15] = 'FPC Installer'#0;
  1406. RunBlock: TRunBlock = (Length: $32;
  1407. Dependent: 0;
  1408. Background: 0;
  1409. TraceLevel: 0;
  1410. PrgTitle: @Title [1];
  1411. PrgName: nil;
  1412. Args: nil;
  1413. TermQ: 0;
  1414. Environment: nil;
  1415. Inheritance: 0;
  1416. SesType: 2;
  1417. Icon: nil;
  1418. PgmHandle: 0;
  1419. PgmControl: 2;
  1420. Column: 0;
  1421. Row: 0;
  1422. Width: 80;
  1423. Height: 25);
  1424. begin
  1425. CheckOS2 := false;
  1426. asm
  1427. mov ah, 30h
  1428. int 21h
  1429. xchg ah, al
  1430. mov DosV, ax
  1431. mov ax, 4010h
  1432. int 2Fh
  1433. cmp ax, 4010h
  1434. jnz @0
  1435. xor bx, bx
  1436. @0:
  1437. mov W, bx
  1438. end;
  1439. if DosV > 3 shl 8 then
  1440. begin
  1441. OwnName := FExpand (ParamStr (0));
  1442. FSplit (OwnName, OwnDir, Name, Ext);
  1443. if (DosV >= 20 shl 8 + 10) and (W >= 20 shl 8 + 10) then
  1444. (* OS/2 version 2.1 or later running (double-checked) *)
  1445. begin
  1446. OwnName [Succ (byte (OwnName [0]))] := #0;
  1447. RunBlock.PrgName := @OwnName [1];
  1448. P := Ptr (PrefixSeg, $80);
  1449. if PByte (P)^ <> 0 then
  1450. begin
  1451. Inc (P);
  1452. RunBlock.Args := Ptr (PrefixSeg, $81);
  1453. end;
  1454. asm
  1455. mov ax, 6400h
  1456. mov bx, 0025h
  1457. mov cx, 636Ch
  1458. mov si, offset RunBlock
  1459. int 21h
  1460. jc @0
  1461. mov DosV, 0
  1462. @0:
  1463. end;
  1464. CheckOS2 := DosV = 0;
  1465. end;
  1466. end;
  1467. end;
  1468. {$ENDIF}
  1469. var
  1470. i : longint;
  1471. begin
  1472. { register objects for help streaming }
  1473. RegisterWHTMLScan;
  1474. {$ifdef FPC}
  1475. {$ifdef win32}
  1476. Dos.Exec(GetEnv('COMSPEC'),'/C echo This dummy call gets the mouse to become visible');
  1477. {$endif win32}
  1478. {$endif FPC}
  1479. (* TH - no error boxes if checking an inaccessible disk etc. *)
  1480. {$IFDEF OS2}
  1481. {$IFDEF FPC}
  1482. DosCalls.DosError (0);
  1483. {$ELSE FPC}
  1484. {$IFDEF VirtualPascal}
  1485. OS2Base.DosError (ferr_DisableHardErr);
  1486. {$ELSE VirtualPascal}
  1487. BseDos.DosError (0);
  1488. {$ENDIF VirtualPascal}
  1489. {$ENDIF FPC}
  1490. {$ENDIF}
  1491. {$IFDEF DOSSTUB}
  1492. if CheckOS2 then Halt;
  1493. {$ENDIF}
  1494. createlog:=false;
  1495. {$ifdef MAYBE_LFN}
  1496. locallfnsupport:=system.lfnsupport;
  1497. {$endif MAYBE_LFN}
  1498. for i:=1 to paramcount do
  1499. begin
  1500. if paramstr(i)='-l' then
  1501. createlog:=true
  1502. {$ifdef MAYBE_LFN}
  1503. else if paramstr(i)='--nolfn' then
  1504. locallfnsupport:=false
  1505. {$endif MAYBE_LFN}
  1506. else if paramstr(i)='-h' then
  1507. begin
  1508. writeln('FPC Installer Copyright (c) 1993-2002 Florian Klaempfl');
  1509. writeln('Command line options:');
  1510. writeln(' -l create log file');
  1511. {$ifdef MAYBE_LFN}
  1512. writeln(' --nolfn force installation with short file names');
  1513. {$endif MAYBE_LFN}
  1514. writeln;
  1515. writeln(' -h displays this help');
  1516. halt(0);
  1517. end
  1518. else
  1519. begin
  1520. writeln('Illegal command line parameter: ',paramstr(i));
  1521. halt(1);
  1522. end;
  1523. end;
  1524. if createlog then
  1525. begin
  1526. assign(log,'install.log');
  1527. rewrite(log);
  1528. {$ifdef MAYBE_LFN}
  1529. if not(locallfnsupport) then
  1530. writeln(log,'OS doesn''t have LFN support');
  1531. {$endif}
  1532. end;
  1533. getdir(0,startpath);
  1534. successfull:=false;
  1535. fillchar(cfg, SizeOf(cfg), 0);
  1536. fillchar(data, SizeOf(data), 0);
  1537. installapp.init;
  1538. FSplit (FExpand (ParamStr (0)), DStr, CfgName, EStr);
  1539. installapp.readcfg(CfgName + CfgExt);
  1540. installapp.checkavailpack;
  1541. { installapp.readcfg(startpath+dirsep+cfgfile);}
  1542. {$ifdef GO32V2}
  1543. if not(lfnsupport) then
  1544. MessageBox('The operating system doesn''t support LFN (long file names),'+
  1545. ' so some packages will get shorten filenames when installed',nil,mfinformation or mfokbutton);
  1546. {$endif}
  1547. installapp.do_installdialog;
  1548. installapp.done;
  1549. if createlog then
  1550. close(log);
  1551. end.
  1552. {
  1553. $Log$
  1554. Revision 1.4 2002-02-28 21:30:34 peter
  1555. * regenated
  1556. Revision 1.3 2002/02/28 17:02:08 pierre
  1557. * fix win32 compilation if DEBUG cond is set
  1558. Revision 1.2 2002/01/29 22:01:17 peter
  1559. * support fvision
  1560. Revision 1.1 2002/01/29 17:59:15 peter
  1561. * moved installer
  1562. Revision 1.2.2.16 2001/11/24 14:29:54 carl
  1563. * ppc386.cfg -> fpc.cfg
  1564. Revision 1.2.2.15 2001/05/02 16:22:43 pierre
  1565. + Shorten file names to comply with Dos 8+3 limitation
  1566. Revision 1.2.2.14 2001/04/19 15:50:24 pierre
  1567. * remove use of reals so emu387 is not needed anymore
  1568. Revision 1.2.2.13 2001/01/02 09:43:12 florian
  1569. * vresion fixed
  1570. Revision 1.2.2.12 2001/01/02 09:35:50 florian
  1571. * targetname is now read from the .dat file too
  1572. Revision 1.2.2.11 2000/11/26 19:02:58 hajny
  1573. * English correction
  1574. Revision 1.2.2.10 2000/11/26 16:49:57 hajny
  1575. * removed unneeded OS/2 conditionals
  1576. Revision 1.2.2.9 2000/11/09 22:02:33 florian
  1577. * fixed bug 1226: wrong target for the win32 IDE
  1578. Revision 1.2.2.8 2000/10/11 18:08:45 peter
  1579. * lfnsupport is only for go32v2
  1580. Revision 1.2.2.7 2000/10/11 16:49:02 florian
  1581. + fixed a typo and the setting of haside and hashtmlhelp
  1582. Revision 1.2.2.6 2000/10/11 13:10:20 florian
  1583. + added preconfiguratioh of help files
  1584. Revision 1.2.2.5 2000/10/10 22:12:10 florian
  1585. + added a message how to start the IDE
  1586. Revision 1.2.2.4 2000/10/10 16:36:12 florian
  1587. + creation of IDE configuration files added
  1588. Revision 1.2.2.3 2000/09/24 10:52:14 peter
  1589. * window can now also be smaller again
  1590. Revision 1.2.2.2 2000/09/22 08:41:36 pierre
  1591. * add emulation for go32v2 and display currently extraced file
  1592. Revision 1.2.2.1 2000/09/21 10:57:11 pierre
  1593. changes by Gabor for scrolling support
  1594. Revision 1.2 2000/07/21 10:43:01 florian
  1595. + added for lfn support
  1596. Revision 1.1 2000/07/13 06:30:21 michael
  1597. + Initial import
  1598. Revision 1.20 2000/07/09 12:55:45 hajny
  1599. * updated for version 1.0
  1600. Revision 1.19 2000/06/18 18:27:32 hajny
  1601. + archive validity checking, progress indicator, better error checking
  1602. Revision 1.18 2000/02/24 17:47:47 peter
  1603. * last fixes for 0.99.14a release
  1604. Revision 1.17 2000/02/23 17:17:56 peter
  1605. * write ppc386.cfg for all found targets
  1606. Revision 1.16 2000/02/06 12:59:39 peter
  1607. * change upper -> upcase
  1608. * fixed stupid debugging leftover with diskspace check
  1609. Revision 1.15 2000/02/02 17:19:10 pierre
  1610. * avoid diskfree problem and get mouse visible
  1611. Revision 1.14 2000/02/02 15:21:31 peter
  1612. * show errorcode in message when error in unzipping
  1613. Revision 1.13 2000/01/26 21:49:33 peter
  1614. * install.pas compilable by FPC again
  1615. * removed some notes from unzip.pas
  1616. * support installer creation under linux (install has name conflict)
  1617. Revision 1.12 2000/01/26 21:15:59 hajny
  1618. * compilable with TP again (lines < 127install.pas, ifdef around findclose)
  1619. Revision 1.11 2000/01/24 22:21:48 peter
  1620. * new install version (keys not wrong correct yet)
  1621. Revision 1.10 2000/01/18 00:22:48 peter
  1622. * fixed uninited local var
  1623. Revision 1.9 1999/08/03 20:21:53 peter
  1624. * fixed sources mask which was not set correctly
  1625. Revision 1.7 1999/07/01 07:56:58 hajny
  1626. * installation to root fixed
  1627. Revision 1.6 1999/06/29 22:20:19 peter
  1628. * updated to use tab pages
  1629. Revision 1.5 1999/06/25 07:06:30 hajny
  1630. + searching for installation script updated
  1631. Revision 1.4 1999/06/10 20:01:23 peter
  1632. + fcl,fv,gtk support
  1633. Revision 1.3 1999/06/10 15:00:14 peter
  1634. * fixed to compile for not os2
  1635. * update install.dat
  1636. Revision 1.2 1999/06/10 07:28:27 hajny
  1637. * compilable with TP again
  1638. Revision 1.1 1999/02/19 16:45:26 peter
  1639. * moved to fpinst/ directory
  1640. + makefile
  1641. Revision 1.15 1999/02/17 22:34:08 peter
  1642. * updates from TH for OS2
  1643. Revision 1.14 1998/12/22 22:47:34 peter
  1644. * updates for OS2
  1645. * small fixes
  1646. Revision 1.13 1998/12/21 13:11:39 peter
  1647. * updates for 0.99.10
  1648. Revision 1.12 1998/12/16 00:25:34 peter
  1649. * updated for 0.99.10
  1650. * new end dialogbox
  1651. Revision 1.11 1998/11/01 20:32:25 peter
  1652. * packed record
  1653. Revision 1.10 1998/10/25 23:38:35 peter
  1654. * removed warnings
  1655. Revision 1.9 1998/10/23 16:57:40 pierre
  1656. * compiles without -So option
  1657. * the main dialog init was buggy !!
  1658. Revision 1.8 1998/09/22 21:10:31 jonas
  1659. * initialize cfg and data with 0 at startup
  1660. Revision 1.7 1998/09/16 16:46:37 peter
  1661. + updates
  1662. Revision 1.6 1998/09/15 13:11:14 pierre
  1663. small fix to cleanup if no package
  1664. Revision 1.5 1998/09/15 12:06:06 peter
  1665. * install updated to support w32 and dos and config file
  1666. Revision 1.4 1998/09/10 10:50:49 florian
  1667. * DOS install program updated
  1668. Revision 1.3 1998/09/09 13:39:58 peter
  1669. + internal unzip
  1670. * dialog is showed automaticly
  1671. Revision 1.2 1998/04/07 22:47:57 florian
  1672. + version/release/patch numbers as string added
  1673. }