home *** CD-ROM | disk | FTP | other *** search
- PROGRAM test;
- {$M 32768}
-
- USES PmDialog,DOS,PmObject,CRT,PmTypes;
-
-
- RESOURCE INSTALL;
-
- TYPE
- TDirectories=RECORD
- BinDir,LibDir,OutDir,PrjDir,LibSrcDir,
- LastDir:String;
- END;
-
- TCompOpt=RECORD
- CodeGen:LONGWORD;
- Syntax:LONGWORD;
- Runtime:LONGWORD;
- Action:LONGWORD;
- Conditional:String;
- Parameter:STRING;
- END;
-
- TLinkOpt=RECORD
- Data:LONGWORD;
- Code:LONGWORD;
- EdOpt:LONGWORD;
- PrefSize:LONGWORD;
- PrefAuto:LONGWORD;
- Language:BOOLEAN;
- Debug:LONGWORD;
- END;
-
- TMemorySizes=RECORD
- Stack:LONGWORD;
- SystemHeap:LONGWORD;
- ExtraHeap:LONGWORD;
- END;
-
- TPrj=RECORD
- id:BYTE;
- PrjName:STRING[248];
- PrjSource:STRING[248];
- PrjMain:STRING[248];
- PrjRemark:STRING[248];
- Directories:TDirectories;
- PrimFile:STRING[248];
- CompOpt:TCompOpt;
- LinkOpt:TLinkOpt;
- MemorySizes:TMemorySizes;
- END;
-
- PSamples=^TSamples;
- TSamples=RECORD
- Name:String;
- Next:PSamples;
- END;
-
- VAR Samples:PSamples;
-
-
- VAR
- InstallDir,SourceDir:STRING;
- InstallOpt:WORD;
- InstallDlg:HWND;
- InstallTID:LONGWORD;
- Akt:String;
- received:BOOLEAN;
- idrive:CHAR;
- InstallLanguage:BOOLEAN;
-
- IMPORTS
- FUNCTION WinCreateObject(ulFlags:LONGWORD;Location,SetupString,Title,
- ClassName:PSZ):LONGWORD: PMWP index 281;
- FUNCTION WinProcessDlg(hwndDlg:HWND):LONGWORD: PMWIN index 796;
- FUNCTION WinPostMsg(mp2,mp1:POINTER;
- msg:LONGWORD;
- _hwnd:HWND):LONGWORD: PMWIN index 919;
- FUNCTION DosCreateThread(Stack,Flags:LONGWORD;Para:POINTER;
- Adr:POINTER;VAR tid:LONGWORD):
- LONGWORD: DOSCALLS index 311;
- PROCEDURE DosKillThread(Tid:LONGWORD): DOSCALLS index 111;
- FUNCTION WinDestroyWindow(_hwnd:HWND):
- LONGWORD: PMWIN index 728;
- FUNCTION DosCopy(option:LONGWORD;
- Dest,Source:PSZ):LONGWORD: DOSCALLS index 258;
- PROCEDURE WinSetDlgItemtext(t:PString;item:LONGWORD;Dlg:HWND):
- PMWIN index 859;
- FUNCTION WinGetPs(Win:HWND):HPS: PMWIN index 757;
- FUNCTION WinReleasePs(ps:HPS):LONGWORD: PMWIN index 848;
- FUNCTION WinDrawBorder(flCmd,clrBack,ClrFore,cy,cx:LONGWORD;
- VAR rec:RECTL;hp:HPS):LONGWORD: PMWIN index 731;
- FUNCTION WinDefDlgProc(Para2,Para1:POINTER;msg:LONGWORD;hwnddlg:HWND):
- LONGWORD: PMWIn index 910;
- FUNCTION WinMessageBox(flStyle:LONGWORD;
- idWindow:LONGWORD;
- pszCaption:PSZ;
- pszText:PSZ;
- hwndOwner:HWND;
- hwndParent:HWND):LONGWORD: PMWIN index 789;
- FUNCTION WinSendMsg(MPARAM2,MPARAM1:POINTER;
- msg:LONGWORD;
- _hwnd:HWND):POINTER: PMWIN index 920;
- END;
-
- TYPE TInstallDialog=OBJECT(TDialog)
- CONSTRUCTOR Init(Parent,Owner:HWND;hmod:HModule;idDlg:LONGWORD;
- pCreateParams:Pointer);
- DESTRUCTOR Done;
- FUNCTION DialogHandleEvent(Dlg:HWND;msg:LONGWORD;
- Para1,Para2:LONGWORD;VAR Handled:BOOLEAN):
- LONGWORD:VIRTUAL;
- END;
-
- TYPE TWaitDialog=OBJECT(TDialog)
- CONSTRUCTOR Init(Parent,Owner:HWND;hmod:HModule;idDlg:LONGWORD;
- pCreateParams:Pointer);
- DESTRUCTOR Done;
- FUNCTION DialogHandleEvent(Dlg:HWND;msg:LONGWORD;
- Para1,Para2:LONGWORD;VAR Handled:BOOLEAN):
- LONGWORD:VIRTUAL;
- END;
-
-
-
-
- CONSTRUCTOR TInstallDialog.Init(Parent,Owner:HWND;hmod:HModule;idDlg:LONGWORD;
- pCreateParams:Pointer);
- BEGIN
- Inherited.Init(Parent,Owner,hmod,idDlg,pCreateParams);
- END;
-
- DESTRUCTOR TInstallDialog.Done;
- BEGIN
- END;
-
- FUNCTION TInstallDialog.DialogHandleEvent(Dlg:HWND;msg:LONGWORD;
- Para1,Para2:LONGWORD;VAR Handled:BOOLEAN):LONGWORD;
- VAR
- r:LONGWORD;
- H:BOOLEAN;
- command:WORD;
- t:BYTE;
- BEGIN
- r:=Inherited.DialogHandleEvent(Dlg,msg,para1,para2,Handled);
- H:=TRUE;
- CASE msg OF
- WM_INITDLG:
- BEGIN
- SettextLimit(Dlg,1018,128); {Install dir}
- SettextLimit(Dlg,1019,128); {Source dir}
-
- SetCheckBoxState(Dlg,1013,1);
- SetCheckBoxState(Dlg,1014,1);
- SetCheckBoxState(Dlg,1015,1);
- SetCheckBoxState(Dlg,1016,1);
- SetCheckBoxState(Dlg,1030,1);
-
- IF InstallLanguage=TRUE THEN {German}
- SetRadioButtonState(Dlg,1040,1)
- ELSE SetRadioButtonState(Dlg,1041,1);
- END;
- WM_COMMAND:
- BEGIN
- command:=Word(Para1);
- CASE command OF
- 1019: {Install}
- BEGIN
- DialogGetText(Dlg,1018,InstallDir,250);
- IF InstallDir[length(InstallDir)]='\' THEN
- dec(InstallDir[0]);
- FOR t:=1 to length(installdir) do
- InstallDir[t]:=upcase(installdir[t]);
-
- DialogGetText(Dlg,1019,SourceDir,250);
- IF SourceDir[length(SourceDir)]='\' THEN
- dec(SourceDir[0]);
- FOR t:=1 to length(sourcedir) do
- SourceDir[t]:=upcase(sourcedir[t]);
- idrive:=SourceDir[1];
-
- InstallOpt:=0;
- IF GetCheckBoxState(Dlg,1013)<>0 THEN
- InstallOpt:=InstallOpt OR 1;
- IF GetCheckBoxState(Dlg,1014)<>0 THEN
- InstallOpt:=InstallOpt OR 2;
- IF GetCheckBoxState(Dlg,1015)<>0 THEN
- InstallOpt:=InstallOpt OR 4;
- IF GetCheckBoxState(Dlg,1016)<>0 THEN
- InstallOpt:=InstallOpt OR 8;
- IF GetCheckBoxState(Dlg,1030)<>0 THEN
- InstallOpt:=InstallOpt OR 16;
- IF GetRadioButtonState(Dlg,1040)<>0 THEN
- InstallLanguage:=TRUE {German}
- ELSE InstallLanguage:=FALSE; {English}
- END;
- END; {case}
- H:=FALSE; {Handled by PM}
- END;
- ELSE H:=FALSE;
- END; {case}
-
- Handled:=H;
- DialogHandleEvent:=r;
-
- END;
-
- CONSTRUCTOR TWaitDialog.Init(Parent,Owner:HWND;hmod:HModule;idDlg:LONGWORD;
- pCreateParams:Pointer);
- BEGIN
- Inherited.Init(Parent,Owner,hmod,idDlg,pCreateParams);
- END;
-
- DESTRUCTOR TWaitDialog.Done;
- BEGIN
- END;
-
- CONST
- WM_ChangeAkt=$1001;
- WM_NextDisk =$1002;
-
- FUNCTION TWaitDialog.DialogHandleEvent(Dlg:HWND;msg:LONGWORD;
- Para1,Para2:LONGWORD;VAR Handled:BOOLEAN):LONGWORD;
- VAR
- r:LONGWORD;
- H:BOOLEAN;
- command:WORD;
- hp:HPS;
- rec:RECTL;
- f:file;
- LABEL l;
- BEGIN
- r:=0;
- H:=TRUE;
- CASE msg OF
- WM_PAINT:
- BEGIN
- r:=WinDefDlgProc(POINTER(para2),POINTER(para1),msg,Dlg);
- hp:=WinGetPs(Dlg);
- Rec.xLeft:= 10;
- Rec.yBottom:= 50;
- Rec.xRight:= 265;
- Rec.yTop:= 120;
- WinDrawBorder($800,CLR_WHITE,CLR_DARKGRAY,1,1,rec,hp);
- WinReleasePs(hp); {Canvas Handle free}
- END;
- WM_ChangeAkt:
- BEGIN
- WinSetDlgItemtext(akt,1018,Dlg);
- received:=TRUE;
- END;
- WM_NextDisk:
- BEGIN
- command:=WORD(Para1);
- l:
- Messagebox('Please insert next disk ('+tostr(command)+
- ') into drive '+idrive+' !');
- assign(f,sourcedir+'\disc'+tostr(command)+'.dsk');
- reset(f,1);
- IF ioresult<>0 THEN goto l;
- close(f);
- received:=TRUE;
- END;
- ELSE H:=FALSE;
- END; {case}
-
- Handled:=H;
- DialogHandleEvent:=r;
- END;
-
- VAR
- Loc,Setup,Title,Class:String;
- ob:LONGWORD;
- InstallDialog:TInstallDialog;
- result:LONGWORD;
-
- PROCEDURE SendMsg(msg,para1,para2:LONGWORD);
- BEGIN
- received:=FALSE;
- WinPostMsg(POINTER(Para2),POINTER(Para1),msg,InstallDlg);
- REPEAT
- UNTIL received=TRUE;
- END;
-
- PROCEDURE NewSampleEntry(s:STRING);
- VAR Dummy:PSamples;
- BEGIN
- dec(s[0],4);
- IF Samples=NIL THEN
- BEGIN
- New(Samples);
- Dummy:=Samples;
- END
- ELSE
- BEGIN
- Dummy:=Samples;
- WHILE Dummy^.next<>NIL DO dummy:=dummy^.Next;
- New(Dummy^.Next);
- Dummy:=Dummy^.Next;
- END;
- Dummy^.Name:=s;
- Dummy^.Next:=NIL;
- END;
-
-
- PROCEDURE UpdateProjects;
- VAR f:file;
- s,s1,s2:string;
- Search:TSearchRec;
- PrjData:TPrj;
- t:word;
- Label l,l1,l2,l3;
- BEGIN
- FindFirst(InstallDir+'\PRJ\*.PRJ',Archive,Search);
- WHILE DosError=0 DO
- BEGIN
- s:=Search.Name;
- l:
- IF s<>'DEFAULT.PRJ' THEN NewSampleEntry(s);
- assign(f,InstallDir+'\PRJ\'+s);
- reset(f,1);
- IF ioresult=0 THEN
- BEGIN
- BlockRead(f,PrjData,sizeof(TPrj));
- IF ioresult<>0 THEN goto l1;
- close(f);
-
- PrjData.LinkOpt.Language:=InstallLanguage;
- PrjData.Directories.BinDir:=InstallDir;
- PrjData.Directories.OutDir:=InstallDir+'\OUTPUT';
- PrjData.Directories.LibDir:=InstallDir+'\LIB';
- PrjData.Directories.PrjDir:=InstallDir+'\PRJ';
- PrjData.Directories.LibSrcDir:=InstallDir+'\SRC\LIB';
- PrjData.Directories.LastDir:=InstallDir+'\DEMOS';
-
- s2:=PrjData.PrjSource;
- IF s2<>'' THEN
- BEGIN
- s1:='';
- FOR t:=length(s2) downto 1 DO
- BEGIN
- IF s2[t]='\' THEN goto l3;
- s1:=s2[t]+s1;
- END;
-
- goto l2;
- l3:
- IF s<>'DEFAULT.PRJ' THEN s2:=InstallDir+'\SAMPLES\'+s1
- ELSE s2:=InstallDir+'\'+s1;
- PrjData.PrjSource:=s2;
- IF PrjData.PrjMain<>'' THEN
- PrjData.PrimFile:=s2+'\'+PrjData.PrjMain;
- l2:
- END;
-
- assign(f,InstallDir+'\PRJ\'+s);
- rewrite(f,1);
- BlockWrite(f,PrjData,sizeof(TPrj));
- l1:
- close(F);
- END;
- FindNext(Search);
- END;
- END;
-
- PROCEDURE ProcessInstall;
- VAR p:POINTER;
- l:LONGWORD;
- dest,source:STRING;
- label ll,err,succ;
- BEGIN
- {****************Disc #1******************************}
- IF InstallOpt AND 1=1 THEN {Binaries}
- BEGIN
- Akt:='Binaries';
- SendMsg(WM_ChangeAkt,0,0);
- Dest:=InstallDir;
- Source:=SourceDir+'\BIN';
- l:=DosCopy(1,Dest,Source);
- IF l<>0 THEN goto err;
-
- Akt:='Projects';
- SendMsg(WM_ChangeAkt,0,0);
- Dest:=InstallDir+'\PRJ';
- Source:=SourceDir+'\PRJ';
- l:=DosCopy(1,Dest,Source);
- IF l<>0 THEN goto err;
- END;
-
- IF InstallOpt AND 2=2 THEN {Sources}
- BEGIN
- Akt:='Sources';
- SendMsg(WM_ChangeAkt,0,0);
- Dest:=InstallDir+'\SRC';
- Source:=SourceDir+'\SRC';
- l:=DosCopy(1,Dest,Source);
- IF l<>0 THEN goto err;
- END;
-
- {****************Disc #2******************************}
- SendMsg(WM_NextDisk,2,0);
-
- IF InstallOpt AND 1=1 THEN {Binaries}
- BEGIN
- Akt:='Binaries';
- SendMsg(WM_ChangeAkt,0,0);
- Dest:=InstallDir;
- Source:=SourceDir+'\BIN';
- l:=DosCopy(1,Dest,Source);
- IF l<>0 THEN goto err;
- END;
-
- IF InstallOpt AND 16=16 THEN {Documentation}
- BEGIN
- Akt:='Documentation';
- SendMsg(WM_ChangeAkt,0,0);
- Dest:=InstallDir+'\DOC';
- Source:=SourceDir+'\DOC';
- l:=DosCopy(1,Dest,Source);
- IF l<>0 THEN goto err;
- END;
-
- {****************Disc #3******************************}
- SendMsg(WM_NextDisk,3,0);
-
- IF InstallOpt AND 4=4 THEN {Libraries files}
- BEGIN
- Akt:='Libraries';
- SendMsg(WM_ChangeAkt,0,0);
- Dest:=InstallDir+'\LIB';
- Source:=SourceDir+'\LIB';
- l:=DosCopy(1,Dest,Source);
- IF l<>0 THEN goto err;
- END;
-
- IF InstallOpt AND 8=8 THEN {sample files}
- BEGIN
- Akt:='Samples';
- SendMsg(WM_ChangeAkt,0,0);
- Dest:=InstallDir+'\SAMPLES';
- Source:=SourceDir+'\SAMPLES';
- l:=DosCopy(1,Dest,Source);
- IF l<>0 THEN goto err;
- END;
-
- {****************Disc #4******************************}
- SendMsg(WM_NextDisk,4,0);
-
- IF InstallOpt AND 1=1 THEN {Binaries}
- BEGIN
- Akt:='Binaries';
- SendMsg(WM_ChangeAkt,0,0);
- Dest:=InstallDir;
- Source:=SourceDir+'\BIN';
- l:=DosCopy(1,Dest,Source);
- IF l<>0 THEN goto err;
- END;
-
- MkDir(InstallDir+'\OUTPUT');
-
- UpdateProjects;
-
- l:=1000;
- goto succ;
- err:
- l:=1001;
- succ:
- p:=POINTER(l);
- WinPostMsg(NIL,p,WM_COMMAND,InstallDlg); {Delete dialog window}
- ll:
- goto ll;
- END;
-
- FUNCTION Install:BOOLEAN;
- VAR
- WaitDialog:TWaitDialog;
- r:LONGWORD;
- BEGIN
- IF InstallLanguage=TRUE THEN WaitDialog.Init(HWND_DESKTOP,0,0,1004,NIL)
- ELSE WaitDialog.Init(HWND_DESKTOP,0,0,1001,NIL);
- WaitDialog.GetDlg(InstallDlg);
-
- DosCreateThread(32768,2,NIL,@ProcessInstall,InstallTid);
- r:=WinProcessDlg(InstallDlg); {Process the dialog}
-
- DosKillThread(InstallTid); {Kill the parent thread}
-
- WinDestroyWindow(InstallDlg);
- {The program will return to here if main program is terminated}
- WaitDialog.Done;
-
- IF r=1000 THEN Install:=TRUE
- ELSE
- BEGIN
- beep(1200,200);
- Install:=FALSE;
- END;
- END;
-
- PROCEDURE CreateInstallDir(s:STRING);
- VAR t:BYTE;
- s1,s2:STRING;
- Drive:CHAR;
- LABEL l,l1;
- BEGIN
- IF length(s)<3 THEN goto l;
- IF s[2]<>':' THEN
- BEGIN
- l:
- ErrorBox(MB_ICONHAND,'Destination directory invalid'+#13+
- 'Specify full pathname !');
- exit; {Error during install}
- END;
- IF s[3]<>'\' THEN goto l;
- Drive:=s[1];
- Delete(s,1,3);
- s1:=Drive+':';
- l1:
- IF s<>'' THEN
- BEGIN
- t:=pos('\',s);
- IF t<>0 THEN
- BEGIN
- s2:=copy(s,1,t);
- delete(s,1,t);
- IF s2[length(s2)]='\' THEN dec(s2[0]);
- s1:=s1+'\'+s2;
- MkDir(s1);
- goto l1;
- END
- ELSE
- BEGIN
- s1:=s1+'\'+s;
- MkDir(s1);
- END;
- END;
- END;
-
- VAR
- LicenseDialog:TDialog;
-
- BEGIN
- InstallLanguage:=TRUE; {German}
- InstallDialog.Init(HWND_DESKTOP,0,0,1000,NIL);
- InstallDialog.ExecDialog(result);
- InstallDialog.Done;
- IF result<>1019 THEN exit; {Install canceled}
-
- IF InstallLanguage=TRUE THEN LicenseDialog.Init(HWND_DESKTOP,0,0,1003,NIL)
- ELSE LicenseDialog.Init(HWND_DESKTOP,0,0,1002,NIL);
- LicenseDialog.ExecDialog(result);
- LicenseDialog.Done;
- IF result<>1019 THEN exit; {Install canceled}
-
- CreateInstallDir(InstallDir);
-
- IF not Install THEN
- BEGIN
- ErrorBox(MB_ICONHAND,'Installation not completed !');
- exit; {Error during install}
- END;
-
- Loc:='<WP_DESKTOP>';
- Setup:='OBJECTID=<SPEED-Pascal/2 Folder>;';
- Setup:=Setup+'ICONFILE='+InstallDir+'\SPEED.ICO';
- Title:='SPEED-Pascal/2';
- Class:='WPFolder';
- ob:=WinCreateObject(1,Loc,Setup,Title,Class);
-
- Loc:='<SPEED-Pascal/2 Folder>';
- Setup:='ICONFILE='+InstallDir+'\SPEED.ICO;';
- Setup:=Setup+'EXENAME='+InstallDir+'\SPEED.EXE';
- Title:='SPEED IDE';
- Class:='WPProgram';
- ob:=WinCreateObject(1,Loc,Setup,Title,Class);
-
- Loc:='<SPEED-Pascal/2 Folder>';
- Setup:='ICONFILE='+InstallDir+'\RESEDIT.ICO;';
- Setup:=Setup+'EXENAME='+InstallDir+'\RESEDIT.EXE';
- Title:='SPEED-Resource Editor';
- Class:='WPProgram';
- ob:=WinCreateObject(1,Loc,Setup,Title,Class);
-
- Loc:='<SPEED-Pascal/2 Folder>';
- Setup:='OBJECTID=<SPEED-Pascal/2 Samples>;';
- Setup:=Setup+'ICONFILE='+InstallDir+'\SAMPLES.ICO';
- Title:='Samples';
- Class:='WPFolder';
- ob:=WinCreateObject(1,Loc,Setup,Title,Class);
-
- WHILE Samples<>NIL DO
- BEGIN
- Loc:='<SPEED-Pascal/2 Samples>';
- Setup:='ICONFILE='+InstallDir+'\SAMPLES\'+Samples^.Name+'\'+
- Samples^.Name+'.ICO;';
- Setup:=Setup+'EXENAME='+InstallDir+'\SAMPLES\'+Samples^.Name+'\'+
- Samples^.name+'.EXE';
- Title:=Samples^.Name;
- Class:='WPProgram';
- ob:=WinCreateObject(1,Loc,Setup,Title,Class);
-
- Samples:=Samples^.Next;
- END;
-
- Messagebox('Installation of Speed-Pascal/2 completed !');
- END.
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-